home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / j / amiga / j41_amig.zoo / changes / x.c < prev   
Encoding:
C/C++ Source or Header  |  1992-03-24  |  9.6 KB  |  311 lines
  1. /* ----------------------------------------------------------------------- */
  2. /* J-Source Version 4.1 - COPYRIGHT 1992 Iverson Software Inc.             */
  3. /* 33 Major Street, Toronto, Ontario, Canada, M5S 2K9, (416) 925 6096      */
  4. /*                                                                         */
  5. /* J-Source is provided "as is" without warranty of any kind.              */
  6. /*                                                                         */
  7. /* J-Source Version 4.1 license agreement:  You may use, copy, and         */
  8. /* modify the source.  You have a non-exclusive, royalty-free right        */
  9. /* to redistribute source and executable files.                            */
  10. /* ----------------------------------------------------------------------- */
  11.  
  12. /*                                                                         */
  13. /* External (Foreign) Stuff                                                */
  14.  
  15. #include "j.h"
  16. #include "a.h"
  17. #include "io.h"
  18. #include "x.h"
  19.  
  20. #if (!LINKJ && SYS & SYS_MACINTOSH)
  21. #include "mac.h"
  22. #include "PrintTraps.h"
  23. #endif
  24.  
  25. #if (SYS & SYS_MACINTOSH)
  26. #include "PrintTraps.h"
  27. #endif
  28.  
  29. #if (SYS & SYS_AMIGA)
  30. void sleep();
  31. #endif
  32.  
  33.  
  34. static DF1(stype){R sc(AT(w));}
  35.  
  36. static DF1(ir){A z;I m;
  37.  RZ(w);
  38.  m=4*WP(AT(w),AN(w),AR(w)); GA(z,CHAR,m,1,0); memcpy(AV(z),w,m);
  39.  R z;
  40. }
  41.  
  42. static DF1(ri){A y,z;I n,r,*s,t;
  43.  PREF1(ri);
  44.  ASSERT(CHAR&AT(w),EVDOMAIN);
  45.  y=(A)AV(w); n=AN(y); r=AR(y); s=AS(y); t=AT(y);
  46.  ASSERT(t==BOOL||t==CHAR||t==INT||t==FL||t==CMPX,EVDOMAIN);
  47.  ASSERT(0<=r,EVRANK);
  48.  DO(r,ASSERT(0<=s[i],EVLENGTH);); ASSERT(n==prod(r,s),EVLENGTH);
  49.  ASSERT((3+AN(w))/4==WP(t,n,r),EVLENGTH);
  50.  GA(z,t,n,r,0); memcpy(AS(z),s,AN(w)-AH*sizeof(I));
  51.  R z;
  52. }
  53.  
  54. static DF1(fxx){
  55.  RZ(w);
  56.  ASSERT(AT(w)&CHAR+BOX,EVDOMAIN);
  57.  ASSERT(1>=AR(w),EVRANK);
  58.  R AT(w)&CHAR ? unsr(ca(w)) : fx(ope(w));
  59. }
  60.  
  61. static DF1(arx){PREF1(arx); ASSERT(BOX&AT(w),EVDOMAIN); R arep(symbrd(onm(w)));}
  62.  
  63. static DF1(drx){PREF1(drx); ASSERT(BOX&AT(w),EVDOMAIN); R drep(symbrd(onm(w)));}
  64.  
  65. static DF1(srx){PREF1(srx); ASSERT(BOX&AT(w),EVDOMAIN); R srep(ope(w),symbrd(onm(w)));}
  66.  
  67. static DF1(trx){PREF1(trx); ASSERT(BOX&AT(w),EVDOMAIN); R trep(ope(w),symbrd(onm(w)));}
  68.  
  69. static DF1(ts){A z;I*x;struct tm*t;time_t now;
  70.  RZ(w);
  71.  time(&now); t=localtime(&now);
  72.  GA(z,INT,6,1,0); x=AV(z);
  73.  x[0]=t->tm_year+1900;
  74.  x[1]=t->tm_mon+1;
  75.  x[2]=t->tm_mday;
  76.  x[3]=t->tm_hour;
  77.  x[4]=t->tm_min;
  78.  x[5]=t->tm_sec;
  79.  R z;
  80. }
  81.  
  82. static DF1(tss){R scf(CLOCK-tssbase);}
  83.  
  84. static DF1(tsit){D t; PREF1(tsit); t=CLOCK; RZ(exec1(w)); R scf(CLOCK-t);}
  85.  
  86. static DF1(dl){
  87.  PREF1(dl);
  88. #if (!LINKJ && SYS & SYS_MACINTOSH)
  89.  {I m=TickCount()+60*i0(w); while(m>TickCount()&&breaker());}
  90. #else
  91.  DO(i0(w), sleep(1); if(!breaker())R 0;);
  92. #endif
  93.  R w;
  94. }
  95.  
  96. static DF1(sp){R sc(bytes);}
  97.  
  98. static DF1(sps){R sc(totbytes);}
  99.  
  100. static DF1(spit){I k;
  101.  PREF1(spit);
  102.  k=maxbytes;
  103.  RZ(exec1(w));
  104.  R sc(maxbytes-k);
  105. }
  106.  
  107.  
  108. #if (!LINKJ && SYS_SESM && SYS & SYS_PCAT)
  109.  
  110. static int      cgav;
  111. extern I        jstratts();
  112. extern void     jstref();
  113. extern void     jstsatts();
  114. extern void     jstslow();
  115.  
  116. static DF1(cgaq){R sc((I)cgav);}
  117.  
  118. static DF1(cgas){
  119.  ASSERT(!AR(w),EVRANK);
  120.  RZ(w=cvt(BOOL,w));
  121.  jstslow(cgav=*(B*)AV(w));
  122.  R mtv;
  123. }
  124.  
  125. static DF1(colorq){A z;I k,*s,*x;UC t[4];
  126.  RZ(w);
  127.  GA(z,INT,8,2,0); s=AS(z); *s=4; *++s=2;
  128.  x=AV(z);
  129.  k=jstratts(); memcpy(t,&k,4L); DO(4, *x++=t[i]/16; *x++=t[i]%16;);
  130.  R z;
  131. }
  132.  
  133. static DF1(colors){I*x;UC c,t[4],*tv;
  134.  RZ(w=vi(w));
  135.  ASSERT(2==AR(w),EVRANK);
  136.  ASSERT(8==AN(w)&&4==*AS(w),EVLENGTH);
  137.  x=AV(w);
  138.  DO(8, ASSERT(0<=x[i]&&x[i]<16,EVDOMAIN););
  139.  tv=t; DO(4, c=16**x++; c+=*x++; *tv++=c;); jstsatts(*(U I*)t);
  140.  R mtv;
  141. }
  142.  
  143. static DF1(refresh){jstref(); R mtv;}
  144.  
  145. static DF1(edit){PROLOG;A t,z;C*s;I k,m,n;
  146.  RZ(w);
  147.  ASSERT(1>=AR(w),EVRANK);
  148.  n=AN(w);
  149.  ASSERT(!n||CHAR&AT(w),EVDOMAIN);
  150.  m=MIN(32767,4000+n);
  151.  GA(t,CHAR,m,1,0);
  152.  k=(I)(15+(C*)AV(t)); k&=0xfffffff0L; s=(C*)k; /* ensure segment aligned */
  153.  memcpy(s,AV(w),n);
  154.  k=jstedit((S)n,(S)m-15,s);
  155.  z=0>k?ca(w):str(k,s);
  156.  EPILOG(z);
  157. }
  158.  
  159. #endif
  160.  
  161.  
  162. #if (!LINKJ && SYS & SYS_MACINTOSH)
  163.  
  164. static DF1(fontq){A z;I*x;
  165.  GA(z,INT,3,1,0); x=AV(z);
  166.  x[0]=texi.tsFont;
  167.  x[1]=texi.tsFace;
  168.  x[2]=texi.tsSize;
  169.  R z;
  170. }
  171.  
  172. static DF1(fonts){I*v;TextStyle old=texi;
  173.  RZ(w=vi(w));
  174.  ASSERT(1==AR(w),EVRANK);
  175.  ASSERT(3==AN(w),EVLENGTH);
  176.  v=AV(w);
  177.  texi.tsFont=v[0];
  178.  texi.tsFace=v[1];
  179.  texi.tsSize=v[2];
  180.  reFont(&old,&texi);
  181.  R mtv;
  182. }
  183.  
  184. static DF1(prtscr){
  185.  PrClose(); PrDrvrClose();
  186.  PrDrvrOpen();
  187.  PrCtlCall(iPrDevCtl,lPrReset,0L,0L);
  188.  PrCtlCall(iPrBitsCtl,&screenBits,&screenBits.bounds,lPaintBits);
  189.  PrDrvrClose();
  190.  PrOpen();
  191.  R mtv;
  192. }
  193. #endif
  194.  
  195.  
  196. static DF1(rlq){R sc(qrl);}
  197.  
  198. static DF1(rls){I k; RE(k=i0(w)); ASSERT(0<k&&k<2147483646L,EVDOMAIN); qrl=k; R mtv;}
  199.  
  200. static DF1(promptq){R cstr(qprompt);}
  201.  
  202. static DF1(prompts){C*v;I n;
  203.  RZ(vs(w));
  204.  n=AN(w); v=(C*)AV(w);
  205.  ASSERT(!memchr(v,'\0',n),EVDOMAIN);
  206.  ASSERT(NPROMPT>=n,EVLIMIT);
  207.  memcpy(qprompt,v,1+n);
  208.  R mtv;
  209. }
  210.  
  211. static DF1(boxq){R str(11L,qbx);}
  212.  
  213. static DF1(boxs){RZ(vs(w)); ASSERT(11==AN(w),EVLENGTH); memcpy(qbx,AV(w),11L); R mtv;}
  214.  
  215. static DF1(evmq){R behead(qevm);}
  216.  
  217. static DF1(evms){A t,*y;
  218.  ASSERT(1==AR(w),EVRANK);
  219.  ASSERT(NEVM==AN(w),EVLENGTH);
  220.  ASSERT(BOX&AT(w),EVDOMAIN);
  221.  y=(A*)AV(w); DO(NEVM, RZ(vs(*y++)););
  222.  RZ(t=link(mtv,w)); ra(t); fa(qevm); qevm=t;
  223.  R mtv;
  224. }
  225.  
  226.  
  227. #if !LINKJ
  228. C jc(k,f1,f2)I k;AF*f1,*f2;{R 0;}
  229. #endif
  230.  
  231.  
  232. F2(foreign){I p,q;
  233.  p=i0(a); q=i0(w);
  234.  switch(XC(p,q)){
  235.   case XC(0,0):   R CDERIV(CIBEAM, host,    0L,       1L,   0L,   0L   );
  236.   case XC(0,1):   R CDERIV(CIBEAM, hostne,  0L,       1L,   0L,   0L   );
  237.   case XC(0,2):   R CDERIV(CIBEAM, script1, script2,  0L,   0L,   0L   );
  238.   case XC(0,3):   R CDERIV(CIBEAM, sscript1,sscript2, 0L,   0L,   0L   );
  239.   case XC(0,55):  R CDERIV(CIBEAM, joff,    0L,       RMAXL,0L,   0L   );
  240.   case XC(1,0):   R CDERIV(CIBEAM, jfdir,   0L,       RMAXL,0L,   0L   );
  241.   case XC(1,1):   R CDERIV(CIBEAM, jfread,  0L,       0L,   0L,   0L   );
  242.   case XC(1,2):   R CDERIV(CIBEAM, 0L,      jfwrite,  0L,   RMAXL,0L   );
  243.   case XC(1,3):   R CDERIV(CIBEAM, 0L,      jfappend, 0L,   RMAXL,0L   );
  244.   case XC(1,4):   R CDERIV(CIBEAM, jfsize,  0L,       0L,   0L,   0L   );
  245.   case XC(1,11):  R CDERIV(CIBEAM, jiread,  0L,       1L,   0L,   0L   );
  246.   case XC(1,12):  R CDERIV(CIBEAM, 0L,      jiwrite,  0L,   RMAXL,1L   );
  247.   case XC(1,55):  R CDERIV(CIBEAM, jferase, 0L,       0L,   0L,   0L   );
  248.   case XC(2,0):   R CDERIV(CIBEAM, 0L,      wnc,      0L,   0L,   0L   );
  249.   case XC(2,1):   R CDERIV(CIBEAM, wnl,     0L,       0L,   0L,   0L   );
  250.   case XC(2,2):   R CDERIV(CIBEAM, save1,   save2,    0L,   0L,   0L   );
  251.   case XC(2,3):   R CDERIV(CIBEAM, psave1,  psave2,   0L,   0L,   0L   );
  252.   case XC(2,4):   R CDERIV(CIBEAM, copy1,   copy2,    0L,   0L,   0L   );
  253.   case XC(2,5):   R CDERIV(CIBEAM, pcopy1,  pcopy2,   0L,   0L,   0L   );
  254.   case XC(2,55):  R CDERIV(CIBEAM, 0L,      wex,      0L,   0L,   0L   );
  255.   case XC(3,0):   R CDERIV(CIBEAM, stype,   0L,       RMAXL,0L,   0L   );
  256.   case XC(3,1):   R CDERIV(CIBEAM, ir,      0L,       RMAXL,0L,   0L   );
  257.   case XC(3,2):   R CDERIV(CIBEAM, ri,      0L,       1L,   0L,   0L   );
  258.   case XC(4,0):   R CDERIV(CIBEAM, ncx,     0L,       0L,   0L,   0L   );
  259.   case XC(4,1):   R CDERIV(CIBEAM, nl1,     nl2,      RMAXL,RMAXL,RMAXL);
  260.   case XC(4,55):  R CDERIV(CIBEAM, ex,      0L,       0L,   0L,   0L   );
  261.   case XC(5,0):   R fdef(CIBEAM,ADV, fxx,0L, a,w,0L, 0L,0L,0L);
  262.   case XC(5,1):   R CDERIV(CIBEAM, arx,     0L,       0L,   0L,   0L   );
  263.   case XC(5,2):   R CDERIV(CIBEAM, drx,     0L,       0L,   0L,   0L   );
  264.   case XC(5,3):   R CDERIV(CIBEAM, srx,     0L,       0L,   0L,   0L   );
  265.   case XC(5,4):   R CDERIV(CIBEAM, trx,     0L,       0L,   0L,   0L   );
  266.   case XC(6,0):   R CDERIV(CIBEAM, ts,      0L,       RMAXL,0L,   0L   );
  267.   case XC(6,1):   R CDERIV(CIBEAM, tss,     0L,       RMAXL,0L,   0L   );
  268.   case XC(6,2):   R CDERIV(CIBEAM, tsit,    0L,       1L,   0L,   0L   );
  269.   case XC(6,3):   R CDERIV(CIBEAM, dl,      0L,       0L,   0L,   0L   );
  270.   case XC(7,0):   R CDERIV(CIBEAM, sp,      0L,       RMAXL,0L,   0L   );
  271.   case XC(7,1):   R CDERIV(CIBEAM, sps,     0L,       RMAXL,0L,   0L   );
  272.   case XC(7,2):   R CDERIV(CIBEAM, spit,    0L,       1L,   0L,   0L   );
  273. #if (!LINKJ && SYS_SESM && SYS & SYS_PCAT)
  274.   case XC(8,0):   R CDERIV(CIBEAM, cgaq,    0L,       RMAXL,0L,   0L   );
  275.   case XC(8,1):   R CDERIV(CIBEAM, cgas,    0L,       RMAXL,0L,   0L   );
  276.   case XC(8,4):   R CDERIV(CIBEAM, colorq,  0L,       RMAXL,0L,   0L   );
  277.   case XC(8,5):   R CDERIV(CIBEAM, colors,  0L,       RMAXL,0L,   0L   );
  278.   case XC(8,7):   R CDERIV(CIBEAM, refresh, 0L,       RMAXL,0L,   0L   );
  279.   case XC(8,9):   R CDERIV(CIBEAM, edit,    0L,       RMAXL,0L,   0L   );
  280. #endif
  281. #if (!LINKJ && SYS & SYS_MACINTOSH)
  282.   case XC(8,16):  R CDERIV(CIBEAM, fontq,   0L,       RMAXL,0L,   0L   );
  283.   case XC(8,17):  R CDERIV(CIBEAM, fonts,   0L,       RMAXL,0L,   0L   );
  284.   case XC(8,19):  R CDERIV(CIBEAM, prtscr,  0L,       RMAXL,0L,   0L   );
  285. #endif
  286.   case XC(9,0):   R CDERIV(CIBEAM, rlq,     0L,       RMAXL,0L,   0L   );
  287.   case XC(9,1):   R CDERIV(CIBEAM, rls,     0L,       RMAXL,0L,   0L   );
  288.   case XC(9,4):   R CDERIV(CIBEAM, promptq, 0L,       RMAXL,0L,   0L   );
  289.   case XC(9,5):   R CDERIV(CIBEAM, prompts, 0L,       RMAXL,0L,   0L   );
  290.   case XC(9,6):   R CDERIV(CIBEAM, boxq,    0L,       RMAXL,0L,   0L   );
  291.   case XC(9,7):   R CDERIV(CIBEAM, boxs,    0L,       RMAXL,0L,   0L   );
  292.   case XC(9,8):   R CDERIV(CIBEAM, evmq,    0L,       RMAXL,0L,   0L   );
  293.   case XC(9,9):   R CDERIV(CIBEAM, evms,    0L,       RMAXL,0L,   0L   );
  294.   case XC(128,0): R CDERIV(CIBEAM, qr,      0L,       2L,   0L,   0L   );
  295.   case XC(128,1): R CDERIV(CIBEAM, rinv,    0L,       2L,   0L,   0L   );
  296.  }
  297.  if(10==p){AF*f1,*f2;
  298.   ASSERT(jc(q,&f1,&f2),EVDOMAIN);
  299.   R CDERIV(CIBEAM, f1,f2, RMAXL,RMAXL,RMAXL);
  300.  }
  301.  ASSERT(0,EVDOMAIN);
  302. }
  303.  
  304. #if (SYS & SYS_AMIGA)
  305. #undef BOOL
  306. #include <dos.h>
  307. void sleep(time) I time; {
  308.  Delay(time);
  309. }
  310. #endif
  311.